Hobby PC 28/Hobby PC 28.iso/MicrografxMM/FlowCharter/Autosamp/MOVE.FRM

Text File | 1997-03-04 | 6KB | 197 lines

VERSION 4.00
Begin VB.Form Form1
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "Move Event DEMO"
   ClientHeight    =   3405
   ClientLeft      =   1320
   ClientTop       =   1695
   ClientWidth     =   3840
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   3810
   Icon            =   "MOVE.frx":0000
   Left            =   1260
   LinkTopic       =   "Form1"
   ScaleHeight     =   3405
   ScaleWidth      =   3840
   Top             =   1350
   Width           =   3960
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   255
      Picture         =   "MOVE.frx":030A
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   4
      Top             =   2070
      Width           =   495
   End
   Begin AbcflowLib.ABC ABC1
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   2760
      Width           =   495
      _version        =   65536
      _extentx        =   873
      _extenty        =   873
      _stockprops     =   1
   End
   Begin VB.Label Label3
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "(c) Micrografx Inc., 1996. All Rights Reserved."
      ForeColor       =   &H80000008&
      Height          =   390
      Left            =   885
      TabIndex        =   0
      Top             =   2145
      Width           =   3000
   End
   Begin VB.Label Label4
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Additionally, X && Y field values are updated indicating each selected shape's position on the chart."
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   240
      TabIndex        =   3
      Top             =   1200
      Width           =   3495
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   $"MOVE.frx":0614
      ForeColor       =   &H80000008&
      Height          =   1095
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   3375
   End
   Begin VB.Label Label2
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "<---- Double-click on this custom OCX in VB 4.0 edit mode to see the event handling code."
      ForeColor       =   &H80000008&
      Height          =   585
      Left            =   720
      TabIndex        =   1
      Top             =   2730
      Visible         =   0   'False
      Width           =   3015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub ABC1_AppQuitNOTIFY()
    End
End Sub

Private Sub ABC1_ChartNewNOTIFY(ByVal Chart As Object)
    Call AddFields(Chart)
End Sub

Private Sub ABC1_FieldValueChangedNOTIFY(ByVal FieldValue As Object, ByVal Object As Object, ByVal Chart As Object)
    If FieldValue.Name = "X" Then
        Object.CenterX = FieldValue.Value
    End If
    If FieldValue.Name = "Y" Then
        Object.CenterY = FieldValue.Value
    End If
    If FieldValue.Name = "Color" Then
        NewColor = FieldValue.Value
        ' Use WHITE if an invalid color is entered
        If NewColor > 256 Or NewColor < 0 Then NewColor = 0
        Object.Shape.FillColor = ABC1.App.BasicColor(NewColor)
    End If
    If FieldValue.Name = "Text" Then
        Object.Text = FieldValue.Value
    End If

End Sub

Private Sub ABC1_NewShapeNOTIFY(ByVal Object As Object, ByVal Chart As Object)
    Call ABC1_ObjectMovedNOTIFY(Object, Chart)
End Sub

Private Sub ABC1_ObjectMovedNOTIFY(ByVal Object As Object, ByVal Chart As Object)
    Dim Obj As Object, Objs As Object

    If Chart.SelectedObjectCount = 1 Then
        Color = ABC1.App.YELLOW
    Else
        Color = ABC1.App.GREEN
    End If


    ABC1.App.HourGlass = True
    Set Objs = Chart.Objects
    Do
        Set Obj = Objs.ItemFromSelection
        Obj.Color = Color
        Obj.FieldValues.Item("X").Value = Obj.CenterX
        Obj.FieldValues.Item("Y").Value = Obj.CenterY
    Loop While Obj.Valid
    ABC1.App.HourGlass = False

End Sub

Private Sub AddFields(Chart As Object)
    Dim NewField As Object

    Chart.NoRepaint = True
    Set NewField = Chart.FieldTemplates.Add("X")
    NewField.Format = 501
    Set NewField = Chart.FieldTemplates.Add("Y")
    NewField.Format = 501
    Set NewField = Chart.FieldTemplates.Add("Color")
    NewField.Format = 500
    NewField.Hidden = True
    Chart.NoRepaint = False
    Chart.Repaint
End Sub

Private Sub Form_Load()
    Dim ABCApp As Object
    Dim CurrentChart As Object

    Set ABCApp = CreateObject("ABCFlow.application")
    ABCApp.Visible = True

    ABCApp.RegisterEvent ABC1, Form1.Caption, "ChartNewNOTIFY"
    ABCApp.RegisterEvent ABC1, Form1.Caption, "FieldValueChangedNOTIFY"
    ABCApp.RegisterEvent ABC1, Form1.Caption, "ObjectMovedNOTIFY"
    ABCApp.RegisterEvent ABC1, Form1.Caption, "NewShapeNOTIFY"

    ' Get the ABC Quit event so the Menu
    ' sample can unload when ABC Quits
    ABCApp.RegisterEvent ABC1, Form1.Caption, "AppQuitNOTIFY"

    Set CurrentChart = ABCApp.ActiveChart

    If (Not CurrentChart.Valid) Then
        MsgBox "Cannot run without a chart. Open a chart in ABC and run the " + App.Title + " again."
        End
    Else
        Call AddFields(CurrentChart)
    End If

End Sub